home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / TIMING.SWG / 0002_Repeat until timeout.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-21  |  1.9 KB  |  65 lines
  1. {The problem:  repeat
  2.                  ...
  3.                until SomeEvent;
  4.  If SomeEvent (external hardware signals etc.) never comes, the program
  5.  hangs. So I did this code to avoid hangup's. Look below for example.
  6.  
  7.  GetTimeWord returns the actual timer value.
  8.  SetTimeOutTicks sets a timeout-value to a word variable TimeVar.
  9.  IsTimeOut returns true when TimeVar >= actual time or false if lower.
  10.  
  11.  All 3 functions/procedures are very fast. The function IsTimeOut runs
  12.  about 2.000.000!/second on a P90-machine.
  13.  
  14.  Dec. 12, 1995, Udo Juerss, 57078 Siegen, Germany, CompuServe [101364,526]}
  15.  
  16. uses
  17.   Crt;
  18. {---------------------------------------------------------------------------}
  19.  
  20. var
  21.   Time  : Word;
  22.   Count : LongInt;
  23. {---------------------------------------------------------------------------}
  24.  
  25. function GetTimeWord:Word; assembler;
  26. asm
  27.            mov   es,Seg0040
  28.            mov   di,6Ch
  29.            mov   ax,word ptr es:[di]
  30. end;
  31. {---------------------------------------------------------------------------}
  32.  
  33. procedure SetTimeOutTicks(Ticks:Word; var TimeVar:Word); assembler;
  34. asm
  35.            call  GetTimeWord
  36.            add   ax,Ticks
  37.            les   di,TimeVar
  38.            stosw
  39. end;
  40. {---------------------------------------------------------------------------}
  41.  
  42.  
  43. function IsTimeOut(TimeVar:Word):Boolean; assembler;
  44. asm
  45.            mov   bx,TimeVar
  46.            call  GetTimeWord
  47.            cmp   ax,bx
  48.            mov   al,0
  49.            jl    @End
  50.            mov   al,1
  51. @End:
  52. end;
  53. {---------------------------------------------------------------------------}
  54.  
  55. begin
  56.   ClrScr;
  57.   Count:=0;
  58.   SetTimeOutTicks(18,Time);               {1 second equals ~18.2 timer ticks}
  59.   Writeln('Waiting for 1 second and counting IsTimeOut query...');
  60.   repeat
  61.     Inc(Count);
  62.   until IsTimeOut(Time);
  63.   Writeln('IsTimeOut query = ',Count:8,' times/sec.');
  64.   ReadKey;
  65. end.